
# This file contains R script that loads the raw dataset produced by z-Tree from
# the experiment studied in Montag, Josef, and James Tremewan. "Let the
# Punishment Fit the Criminal: An Experimental Study." 

# It prepares the subject-level (wide) and partner-level (long) dataset and
# creates useful variables. 

# Authors: 

# Josef Montag | josef.montag@gmail.com
# International School of Economics
# Kazakh-British Technical University

# James Tremewan | james.tremewan@wu.ac.at@gmail.com
# Vienna University of Economics and Business, and  
# Vienna Center for Experimental Economics, University of Vienna 

# September 15, 2017 

# The script was tested to work in R version 3.3.3 (2017-03-06), R Core Team.
# 2017. "R: A language and environment for statistical computing." R Foundation
# for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.

# You need to have installed the libraries required by the code.

# Head {{{1

library(readODS)
library(reshape2)
library(foreign)

# Read the zTree output dataset {{{1

d.raw <- read.ods('Data/DiffPunishData.ods', 1)

# Create useful variables and recode {{{1

d.subject <- d.raw
names(d.subject) <- d.subject[1, ]
d.subject <- d.subject[-1, ]
d.subject <- as.data.frame(sapply(d.subject, as.numeric))
d.subject <- within(d.subject, {
  Treatment <- factor(Sliders, levels = 0:1, 
                               labels = c('Monetary (euro)', 
                                          'Non-monetary (sliders)'))
  treatment <- factor(Sliders, levels = 0:1, 
                               labels = c('Monetary', 
                                          'Non-monetary'))
  donate.t  <- factor(donate, levels = c(50, 25, 0),
                      labels = c('Do nothing', 'Take half', 'Take all'))
  male.t    <- factor(male, levels = 1:2, labels = c('Male', 'Female'))
  female    <- male -1
  PunOpts1mean <- rowMeans(d.subject[grep('PunOptions1.*', names(d.subject))])
  PunOpts2mean <- rowMeans(d.subject[grep('PunOptions2.*', names(d.subject))])
  PunOpts3mean <- rowMeans(d.subject[grep('PunOptions3.*', names(d.subject))])
  NeverPunish  <- PunOpts1mean + PunOpts2mean + PunOpts2mean == 0
  Spite <-
    `PunOptions1[1]` * `PunOptions2[1]` * `PunOptions3[1]` *
    `PunOptions1[2]` * `PunOptions2[2]` * `PunOptions3[2]` *
    `PunOptions1[3]` * `PunOptions2[3]` * `PunOptions3[3]` *
    `PunOptions1[4]` * `PunOptions2[4]` * `PunOptions3[4]` *
    `PunOptions1[5]` * `PunOptions2[5]` * `PunOptions3[5]` > 0
  PunNothing  <- as.numeric(PunOpts3mean > 0)
  PunTakeHalf <- as.numeric(PunOpts2mean > 0)
  PunTakeAll  <- as.numeric(PunOpts1mean > 0)
  id          <- paste(Session, Subject, sep = '_')
  PunUnif <- as.numeric(
    apply(d.subject[grep('PunOptions1.*', names(d.subject))], 1, var) == 0 &
    apply(d.subject[grep('PunOptions2.*', names(d.subject))], 1, var) == 0 &
    apply(d.subject[grep('PunOptions3.*', names(d.subject))], 1, var) == 0 
    ) & !NeverPunish
  TimeST <- 9999 - TimeOKSliderTaskOK
  crt <- (CRT1 == 5) + (CRT2 == 5) + (CRT3 == 47)
  PunisherType <- ifelse(NeverPunish,
                         'Never punish', 
                         ifelse(PunUnif, 
                                'Punish uniformly',
                                'Vary punishment'
                                )
                         )
  VaryPunishment <- PunisherType == 'Vary punishment'
  Donation <- ifelse(Donation == -1, 0, Donation)
})

# Produce partner-level (long) dataset for Stata {{{1

# Create the long-form dataset {{{2

ids <- names(subset(d.subject, 
    select = c(Session:wtp, TimeOKSliderTaskOK:Treatment)))
  
d.partner <- melt(d.subject, id = ids)
d.partner <- within(d.partner, {
  variable    <- as.character(variable)
  partner     <- substr(variable, nchar(variable) -1,  nchar(variable) -1)
  variable    <- substr(variable, 1,  nchar(variable) -3)
  PunOption   <- ifelse(grepl('PunOptions', variable),
                        substr(variable, nchar(variable), nchar(variable)), NA)
  variable    <- ifelse(grepl('PunOptions', variable),
                        substr(variable, 1, nchar(variable) -1), variable)
  id_partner  <- paste(id, partner, sep = '_')
})

d.partner <- dcast(d.partner, ... ~ variable + PunOption) 
names(d.partner) <- sub('(_|_NA)$', '', names(d.partner))

# Create useful variables for regressions {{{2 

d.partner <- within(d.partner, {
  proppunish_1 <- ifelse(treatment == 'Monetary',
                         (PunOptions_1 / 5) * 100,
                         (PunOptions_1 / 100) * 100)
  proppunish_2 <- ifelse(treatment == 'Monetary',
                         (PunOptions_2 / 5) * 100,
                         (PunOptions_2 / 100) * 100)
  proppunish_3 <- ifelse(treatment == 'Monetary',
                         (PunOptions_3 / 5) * 100,
                         (PunOptions_3 / 100) * 100)
  punoptions_1adj <- ifelse(treatment == 'Non-monetary',
                            PunOptions_1 * (PartnersWTP + 0.25) / 100,
                            PunOptions_1)
  punoptions_2adj <- ifelse(treatment == 'Non-monetary',
                            PunOptions_2 * (PartnersWTP + 0.25) / 100,
                            PunOptions_2)
  punoptions_3adj <- ifelse(treatment == 'Non-monetary',
                            PunOptions_3 * (PartnersWTP + 0.25) / 100,
                            PunOptions_3)
  PartnersEarnings25 <- as.integer(PartnersEarnings == 2.5)
  PartnersEarnings50 <- as.integer(PartnersEarnings == 5)
  PartnersWealth25 <- as.integer(PartnersWealth == 2.5)
  PartnersWealth50 <- as.integer(PartnersWealth == 5)
})

# Save data in R and Stata formats [SAVING TURNED OFF] {{{2 

# write.dta(d.partner, 'Data/data_level_partner.dta')
# save.image('Data/data.Rdata')
